perm filename SIMAUX.SAI[SYS,HE]1 blob
sn#004154 filedate 1972-11-02 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00019 PAGES
RECORD PAGE DESCRIPTION
00001 00001 VALID 00019 PAGES
00007 00002 ENTRY READ_FROM_DISK, INTN, INTNS,INTNA, GETS, SINGULAR,
00010 00003 *** DISK I/O STUFF ***
00013 00004 INTERNAL REAL ITEMVAR PROCEDURE INTNS(STRING SREAL V)
00014 00005 ⊃ *** LINEAR EQUATION SOLVER PROCEDURES FOLLOW. ***
00017 00006 IF BIGGEST=0 THEN
00019 00007 INTERNAL PROCEDURE IMPROVE(INTEGER NSAFE REAL ARRAY A,LU,B,XREFERENCE REAL DIGITS)
00022 00008 ⊃ ** NUMBER CRUNCHING ROUTINES ***
00024 00009 INTERNAL PROCEDURE WXFORM(SAFE REAL ARRAY FRUM,TU,TRANS)
00027 00010 INTERNAL PROCEDURE BESTIN(SAFE REAL ARRAY PJ,QJ,PK,QK,INTREFERENCE REAL MISDIS)
00029 00011 INTERNAL PROCEDURE MATMULT(SAFE REAL ARRAY A,B,CINTEGER N)
00030 00012 ⊃ *** MISC. HOUSEKEEPING ROUTINES ***
00031 00013 ⊃ *** SOME USEFUL PROCEDURES ***
00033 00014 INTERNAL ITEMVAR PROCEDURE NEXTV(SAFE REAL ARRAY ITEMVAR V1,V2)
00035 00015 ⊃ *** MORE USEFUL ROUTINES ***
00036 00016 T IS TOP AND B IS BOTTOM IMAGE VERTEX ASSUMED TO LIE
00039 00017 INTERNAL PROCEDURE HORIZ_PLANE_PT(SAFE REAL ARRAY ITEMVAR U,K)
00042 00018 INTERNAL BOOLEAN PROCEDURE PARALLEL(ITEMVAR E1,E2)
00046 00019 INTERNAL PROCEDURE VERT2
00047 ENDMK
⊗;
ENTRY READ_FROM_DISK, INTN, INTNS,INTNA, GETS, SINGULAR,
DECOMPOSE, SOLVE, IMPROVE, ACCUMDOTPROD, INVERT,
TRANSPOSE,
HOMO_XFRM, WXFORM, IMAGE_POINT, BESTIN, MATMULT,
PRINTNAME, GENSYM, VERT, LENTH, GLENTH,
NEXTV, CROSS_PROD, HIGHEST, LOWEST, VERT_LINE_PT,
VERT_PLANE_PT, HORIZ_PLANE_PT, DOT_PROD, ANGLE, PARALLEL,
VERT0, VERT1, VERT2;
BEGIN "AUXILIARY SIMPLE PROCEDURES"
REQUIRE 400 PNAMES;
REQUIRE "PREAMB.SAI[SYS,HE]" SOURCE_FILE;
REQUIRE "SAITRG[SYS,HE]" LOAD_MODULE;
REQUIRE "DPDP.REL[SYS,HE]" LOAD_MODULE;
REQUIRE "<>||" DELIMITERS;
EXTERNAL REAL PROCEDURE SQRT(REAL X);
EXTERNAL REAL PROCEDURE ACOS(REAL X);
EXTERNAL REAL PROCEDURE ATAN(REAL X);
COMMENT ***** LOCAL THINGS ***** ;
INTERNAL SAFE REAL ARRAY A,AI[1:3,1:3],LENS[1:3];
COMMENT A AND AI MATRICES FOR THE OBJECT BEING CONSIDERED
AT THE MOMENT -- A IS COLINEATION MATRIX (TABLE → SCREEN)
AND AI ITS INVERSE (SCREEN → TABLE).
BOTH MUST BE POST-MULTIPLIED ;
INTERNAL SAFE REAL ARRAY MCP[1:3];
INTERNAL SAFE REAL ARRAY CTABLE[1:4];
INTERNAL REAL LX,DIGITS,MDP;
INTERNAL ITEMVAR NEXTSYM,TTT;
INTERNAL ITEMVAR Y,L1,L2,L3,LASTL;
INTERNAL SAFE REAL ARRAY ITEMVAR X,V1,V2,V3,V4,VA,VB,B;
INTERNAL SET SES,SVS,S1,VERTEDG;
INTERNAL INTEGER C,ICX,ICY,SPECIAL_VERT,VERT0F;
INTERNAL BOOLEAN BVERT;
DEFINE FILE=<7>,SIBS=<13>,ID=<7>,FIRST1=<8>,SOMETHING=<9>,
WAIT=<>,∂=<DATUM>,
YES=<(INCHWL="Y")>,TYPE=< OUT(1,>,EOM=<&'12&'15);>,TTY=<1>,
ADJ(L1,L2)=<((ENDPT⊗L1) ∩ (ENDPT⊗L2) ≠ PHI)>, ⊃=<COMMENT>,
GADJ(L1,L2)=<((GLOBAL ENDPT⊗L1) ∩ (GLOBAL ENDPT⊗L2) ≠ PHI)>;
DEFINE LAEQ(A,B)"{}"={ABS(A-B)<0.49};
DEFINE S1U=<STEP 1 UNTIL>,ASSIGN=<FOREACH>,HOLDS=<DO DONE;>,
READ=<INTN(GETS)>,READS(A)=<INTNS(GETS,A)>, READA(A)=<INTNA(GETS,A)>;
COMMENT *** DISK I/O STUFF ***;
INTERNAL PROCEDURE READ_FROM_DISK;
BEGIN "READ THE SCENE FROM THE DISK"
DEFINE DATA=<14>,XFER(A,B)=<ARRYIN (DATA,A,B)>;
INTEGER BREAK,EOF;
INTEGER MAXOBJ,I,J;
STRING STR;
ITEMVAR X,Y;
REAL ITEMVAR XR;
OPEN(DATA,"DSK",'10,2,0,200,BREAK,EOF);
DO BEGIN
TYPE "ENTER SCENE NUMBER: (Q TO EXIT)" EOM;
STR←INCHWL;
IF STR="Q"
THEN BEGIN XR←NEW(-999.0); PUT XR IN BLOBS; RETURN; END;
STR←"EDG"&STR&".SCN";
IF TYP_SIMP
THEN TYPE "LOOKING UP FILE:"&STR EOM;
LOOKUP (DATA,STR,EOF);
END UNTIL ¬EOF;
XFER (CAMERA_MODEL[1,1],30);
TYPE "CAMERA MODEL READ IN:" EOM;
FOR I←1 STEP 1 UNTIL 10 DO
BEGIN
STR←NULL;
FOR J←1 STEP 1 UNTIL 3 DO
STR←STR&CVG(CAMERA_MODEL[I,J]);
TYPE STR EOM;
END;
XFER (MAXOBJ,1);
CURCAM←GLOBAL NEW(CAMERA_MODEL);
TYPE "THERE ARE "&CVS(MAXOBJ)&" OBJECTS IN THE DISK SCENE" EOM;
FOR I←1 STEP 1 UNTIL MAXOBJ DO
BEGIN
X←GLOBAL NEW;
PUT X IN BLOBS;
GLOBAL MAKE XFORM⊗X≡CURCAM;
XFER (J,1); COMMENT SIZE OF ARRAY;
IF J THEN BEGIN SAFE REAL ARRAY GG[1:2,0:J];
TYPE "THE SIZE OF THE BOUNDARY ARRAY IS "&CVS(J) EOM;
XFER(GG[1,0],(J+1)*2);
Y←GLOBAL NEW(GG);
GLOBAL MAKE BOUNDARY⊗X≡Y;
END;
XFER (J,1);
IF J THEN BEGIN SAFE REAL ARRAY GG[1:4,0:J];
TYPE "THE SIZE OF THE INSIDE EDGE ARRAY IS "&CVS(J) EOM;
XFER(GG[1,0],(J+1)*4);
Y←GLOBAL NEW(GG);
GLOBAL MAKE INSIDE_EDGES⊗X≡Y;
END;
END;
OUTSTR("MODEL COMPLETED
");
RELEASE (DATA);
END;
COMMENT
THIS IS THE MECHANISM FOR READING IN PROTOTYPES,
HANDLING NEW ITEMS IN THE WORLD;
INTERNAL ITEMVAR PROCEDURE INTN(STRING S);
BEGIN ITEMVAR X;
INTEGER I;
X←CVSI (S,I);
IF I THEN BEGIN X←GLOBAL NEW; NEW_PNAME (X,S) END;
RETURN(X)
END;
INTERNAL REAL ITEMVAR PROCEDURE INTNS(STRING S;REAL V);
BEGIN REAL ITEMVAR X;
X←INTN(S);
GLOBAL DATUM(X)←V;
RETURN(X)
END;
INTERNAL SAFE REAL ARRAY ITEMVAR PROCEDURE INTNA(STRING S;SAFE REAL ARRAY A);
BEGIN SAFE REAL ARRAY ITEMVAR X;
INTEGER I;
X←CVSI(S,I);
IF I THEN BEGIN X←GLOBAL NEW(A); NEW_PNAME(X,S) END;
RETURN(X)
END;
INTERNAL STRING PROCEDURE GETS;
BEGIN STRING S;
S←INPUT(FILE,FIRST1); RETURN (INPUT(FILE,ID))
END;
⊃ *** LINEAR EQUATION SOLVER PROCEDURES FOLLOW. ***;
INTERNAL SAFE INTEGER ARRAY PS[1:10];
INTERNAL PROCEDURE SINGULAR(INTEGER WHY);
COMMENT PRINTS ERROR MESSAGES FOR DECOMPOSE AND IMPROVE;
CASE WHY OF
BEGIN
TYPE "MATRIX WITH ZERO ROW IN DECOMPOSE." EOM;
TYPE "SINGULAR MATRIX IN DECOMPOSE. SOLVE WILL DIVIDE BY ZERO." EOM;
TYPE "NO CONVERGENCE IN IMPROVE. MATRIX IS NEARLY SINGULAR." EOM;
END ;
INTERNAL PROCEDURE DECOMPOSE(INTEGER N;SAFE REAL ARRAY A,LU);
COMMENT A,LU[1:N,1:N];
COMMENT USES GLOBAL SAFE INTEGER ARRAY PS;
COMMENT COMPUTES TRIANGULAR MATRICES L AND U AND PERMUTATION
MATRIX P SO THAT LU=PA. STORES L-I AND U IN LU.
ARRAY PS CONTAINS PERMUTED ROW INDICES;
COMMENT DECOMPOSE(N,A,A) OVERWRITES A WITH LU;
BEGIN
LABEL ENDKLOOP;
SAFE REAL ARRAY SCALES[1:N];
INTEGER I,J,K,PIVOTINDEX;
REAL NORMROW,PIVOT,SIZE,BIGGEST,MULT;
COMMENT INITIALIZE PS,LU AND SCALES;
FOR I←1 STEP 1 UNTIL N DO
BEGIN
PS[I]←I;
NORMROW←0;
FOR J←1 STEP 1 UNTIL N DO
BEGIN
LU[I,J]←A[I,J];
IF (NORMROW<ABS(LU[I,J])) THEN NORMROW←ABS(LU[I,J]);
END;
IF (NORMROW≠0) THEN SCALES[I]←1/NORMROW
ELSE BEGIN SCALES[I]←0; SINGULAR(0); END;
END;
COMMENT GAUSSIAN ELIMINATION WITH PARTIAL PIVOTING;
FOR K←1 STEP 1 UNTIL N-1 DO
BEGIN
BIGGEST←0;
FOR I←K STEP 1 UNTIL N DO
BEGIN
SIZE←ABS(LU[PS[I],K])*SCALES[PS[I]];
IF (BIGGEST<SIZE) THEN
BEGIN BIGGEST←SIZE; PIVOTINDEX←I; END;
END;
IF BIGGEST=0 THEN
BEGIN SINGULAR(1); GO TO ENDKLOOP; END;
IF PIVOTINDEX≠K THEN
BEGIN
J←PS[K];PS[K]←PS[PIVOTINDEX];PS[PIVOTINDEX]←J;
END;
PIVOT←LU[PS[K],K];
FOR I←K+1 STEP 1 UNTIL N DO
BEGIN
LU[PS[I],K]←MULT←(LU[PS[I],K]/PIVOT);
IF MULT ≠0 THEN
FOR J←K+1 STEP 1 UNTIL N DO
LU[PS[I],J]←LU[PS[I],J]-MULT*LU[PS[K],J];
COMMENT INNER LOOP. ONLY COLUMN SUBSCRIPT
VARIES. USE MACHINE CODE IF NECESSARY
FOR EFFICIENCY;
END;
ENDKLOOP:
END;
IF (LU[PS[N],N]=0) THEN SINGULAR(1);
END ;
INTERNAL PROCEDURE SOLVE(INTEGER N;SAFE REAL ARRAY LU,B,X);
COMMENT LU[1:N,1:N],B,X[1:N];
COMMENT USES GLOBAL SAFE INTEGER ARRAY PS;
COMMENT SOLVES AX=B USING LU FROM DECOMPOSE;
BEGIN
INTEGER I,J;
REAL DOT;
FOR I←1 STEP 1 UNTIL N DO
BEGIN
DOT←0;
FOR J←1 STEP 1 UNTIL I-1 DO
DOT←DOT+LU[PS[I],J]*X[J];
X[I]←B[PS[I]]-DOT;
END;
FOR I←N STEP -1 UNTIL 1 DO
BEGIN
DOT←0;
FOR J←I+1 STEP 1 UNTIL N DO
DOT←DOT+LU[PS[I],J]*X[J];
X[I]←(X[I]-DOT)/LU[PS[I],I];
END;
COMMENT AS IN DECOMPOSE, THE INNER LOOPS INVOLVE ONLY THE COLUMN
SUBSCRIPT OF LU AND MAY BE MACHINE CODED FOR EFFICIENCY;
END;
INTERNAL PROCEDURE IMPROVE(INTEGER N;SAFE REAL ARRAY A,LU,B,X;REFERENCE REAL DIGITS);
COMMENT A,LU[1:N,1:N],B,X[1:N];
COMMENT A IS THE ORIGINAL MATRIX, LU IS FROM DECOMPOSE,B IS THE
RIGHT HAND SIDE,X IS THE SOLUTION FROM SOLVE. IMPROVES
X TO MACHINE ACCURACY AND SETS DIGITS TO THE NUMBER
OF DIGITS OF X WHICH DO NOT CHANGE;
COMMENT MACHINE DEPENDENT QUANTITIES INDICATED BY 0-0;
BEGIN
LABEL CONVERGED;
SAFE REAL ARRAY R[1:N],DX[1:N];
INTEGER ITER, ITMAX,I;
REAL T,NORMX,NORMDX,EPS;
FORTRAN REAL PROCEDURE ALOG10;
INTERNAL REAL PROCEDURE ACCUMDOTPROD
(INTEGER N;SAFE REAL ARRAY A;INTEGER I;SAFE REAL ARRAY X;REAL EXTRATERM);
BEGIN
FORTRAN REAL PROCEDURE ADPFOR;
REAL SUM;
COMMENT THIS PROCEDURE SHOULD EVALUATE THE INNER PRODUCT OF
THE I-TH ROW OF ARRAY A WITH THE VECTOR X, THEN
ADD EXTRATERM TO THE RESULT. THE MULTIPLICATION
A[I,J]*X[J] MUST YIELD A DOUBLE PRECISION RESULT
AND ALL THE ADDITIONS MUST BE DONE IN DOUBLE
PRECISION. THE BODY OF THE PROCEDURE CANNOT BE
WRITTEN IN GOGOL;
SUM←ADPFOR(N,A[1,1],I,X[1],EXTRATERM);
RETURN (SUM);
END;
EPS←1.0@-8;
ITMAX←16;
NORMX←0;
FOR I←1 STEP 1 UNTIL N DO
IF (NORMX<ABS(X[I])) THEN NORMX←ABS(X[I]);
IF NORMX=0 THEN
BEGIN DIGITS←-ALOG10(EPS); GO TO CONVERGED END;
FOR ITER ←1 STEP 1 UNTIL ITMAX DO
BEGIN
FOR I←1 STEP 1 UNTIL N DO
R[I]←ACCUMDOTPROD(N,A,I,X,B[I]);
SOLVE(N,LU,R,DX);
NORMDX←0;
FOR I←1 STEP 1 UNTIL N DO
BEGIN
T←X[I];
X[I]←X[I]+DX[I];
IF (NORMDX<ABS(X[I]-T)) THEN NORMDX←ABS(X[I]-T);
END;
IF ITER =1 THEN
DIGITS←-ALOG10(IF (NORMDX≠0)THEN NORMDX/NORMX
ELSE EPS);
IF (NORMDX≤EPS*NORMX) THEN GO TO CONVERGED;
END ;
COMMENT ITERATION DID NOT CONVERGE;
SINGULAR(2);
CONVERGED:
END;
⊃ ** NUMBER CRUNCHING ROUTINES ***;
INTERNAL PROCEDURE INVERT(SAFE REAL ARRAY MAT,INVMAT;INTEGER N);
COMMENT INVERTS A NXN MATRIX;
BEGIN SAFE REAL ARRAY LU[1:N,1:N],IDENTROW,X[1:N];
INTEGER I,J;
DECOMPOSE(N,MAT,LU);
FOR I←1 S1U N DO
BEGIN
FOR J←1 S1U N DO IDENTROW[J]←IF I=J THEN 1.0 ELSE 0.0;
SOLVE(N,LU,IDENTROW,X);
IMPROVE(N,MAT,LU,IDENTROW,X,DIGITS);
FOR J←1 STEP 1 UNTIL N DO INVMAT[J,I]←X[J];
END;
END;
INTERNAL PROCEDURE TRANSPOSE(SAFE REAL ARRAY TO,FROM);
BEGIN "TRANSPOSE"
INTEGER I,J;
SAFE REAL ARRAY TEMP[1:4,1:4];
FOR I←1 S1U 4 DO
FOR J←1 S1U 4 DO
TEMP[J,I]←FROM[I,J];
ARRTRAN(TO,TEMP);
END "TRANSPOSE";
INTERNAL PROCEDURE HOMO_XFRM(SAFE REAL ARRAY P,T);
COMMENT TRANSFORM P BY THE 4X4 HOMOGENEOUS TRANSFORMATION MATRIX T;
BEGIN SAFE REAL ARRAY TEMP[1:4];
INTEGER I,J;
FOR I←1 S1U 4 DO
BEGIN
TEMP[I]←0.0;
FOR J←1 S1U 4 DO
TEMP[I]←TEMP[I]+T[I,J]*P[J];
END;
FOR J←1 S1U 4 DO P[J]←TEMP[J]/TEMP[4];
END;
INTERNAL PROCEDURE WXFORM(SAFE REAL ARRAY FRUM,TU,TRANS);
BEGIN SAFE REAL ARRAY TEMP[1:3];
INTEGER I,J;
FOR I←1 S1U 3 DO
BEGIN
TEMP[I]←0.0;
FOR J←1 S1U 3 DO
TEMP[I]←TEMP[I]+FRUM[J]*TRANS[I,J];
END;
FOR I←1 S1U 3 DO TU[I]←TEMP[I]/TEMP[3];
RETURN;
END;
INTERNAL PROCEDURE IMAGE_POINT(SAFE REAL ARRAY V;REFERENCE INTEGER X,Y);
COMMENT FIND THE IMAGE COORDINATES OF POINT V;
BEGIN REAL VZ,T0,TX,TY,W;
VZ←V[3];
T0←VZ/(VZ-LENS[3]);
TX←LENS[1]*T0+V[1]*(1-T0);
TY←LENS[2]*T0+V[2]*(1-T0);
W←TX*A[3,1]+TY*A[3,2]+A[3,3];
X←(TX*A[1,1]+TY*A[1,2]+A[1,3])/W;
Y←(TX*A[2,1]+TY*A[2,2]+A[2,3])/W;
RETURN;
END;
INTERNAL PROCEDURE IMAGECOR(SAFE REAL ARRAY W;REFERENCE REAL X,Y);
COMMENT FIND THE IMAGE COORDINATES OF POINT W, USING SHY'S PROCEDURE;
BEGIN "IMAGE COOR"
INTEGER I,J,K; REAL AC,DC;SAFE REAL ARRAY V,U[1:3];
AC←LENS[3];DC←W[3]-AC;
V[1]←(LENS[1]*W[3]-AC*W[1])/DC;
V[2]←(LENS[2]*W[3]-AC*W[2])/DC;
V[3]←1;
FOR I←1,2,3 DO BEGIN
AC←0;
FOR J←1,2,3 DO AC←AC+A[I,J]*V[J];
U[I]←AC;
END;
X←U[1]/U[3]; Y←U[2]/U[3];
END "IMAGE COOR";
INTERNAL PROCEDURE TABLECOR(SAFE REAL XI,YI;REFERENCE REAL XT,YT);
COMMENT TRANSFORM IMAGE COORDS TO TABLE TOP COORDS;
BEGIN "TABLECOR"
INTEGER I,J,K; REAL AC; SAFE REAL ARRAY V,U[1:3];
V[1]←XI; V[2]←YI; V[3]←1;
FOR I←1 ,2,3 DO BEGIN
AC←0;
FOR J←1,2,3 DO AC←AC+AI[I,J]*V[J];
U[I]←AC;
END;
XT←U[1]/U[3];
YT←U[2]/U[3];
END "TABLECOR";
INTERNAL PROCEDURE BESTIN(SAFE REAL ARRAY PJ,QJ,PK,QK,INT;REFERENCE REAL MISDIS);
COMMENT FINDS THE "BEST INTERSECTION" OF 2 SKEW LINES;
BEGIN SAFE REAL ARRAY VJ[1:3],VK[1:3],DIS[1:3],PD[1:3];
REAL A,B,C,D,E,DET,TJ,TK; INTEGER I;
A←B←C←D←E←MISDIS←0;
FOR I←1 STEP 1 UNTIL 3 DO
BEGIN
PD[I]←PK[I]-PJ[I];
VJ[I]←QJ[I]-PJ[I];
VK[I]←QK[I]-PK[I];
A←A+VJ[I]↑2;
B←B-VJ[I]*VK[I];
C←C+VK[I]↑2;
D←D+PD[I]*VJ[I];
E←E-PD[I]*VK[I];
END;
DET←A*C-B↑2;
TJ←(C*D-B*E)/DET;
TK←(A*E-B*D)/DET;
FOR I←1 STEP 1 UNTIL 3 DO
BEGIN
INT[I]←(PJ[I]+PK[I]+TK*VK[I]+TJ*VJ[I])/2;
DIS[I]←TJ*VJ[I]-TK*VK[I]-PD[I];
MISDIS←MISDIS+DIS[I]↑2;
END;
MISDIS←SQRT(MISDIS);
RETURN;
END;
INTERNAL PROCEDURE MATMULT(SAFE REAL ARRAY A,B,C;INTEGER N);
BEGIN
COMMENT MULTIPLIES 2 NXN MATRICES;
INTEGER I,J,K; REAL SUM;
SAFE REAL ARRAY D[1:N,1:N];
FOR I←1 STEP 1 UNTIL N DO
FOR J←1 STEP 1 UNTIL N DO
BEGIN
SUM←0.0;
FOR K←1 STEP 1 UNTIL N DO
SUM←SUM+A[I,K]*B[K,J];
D[I,J]←SUM;
END;
ARRTRAN(C,D);
RETURN;
END;
⊃ *** MISC. HOUSEKEEPING ROUTINES ***;
INTERNAL STRING PROCEDURE PRINTNAME(ITEMVAR X);
BEGIN INTEGER I, J, K;
STRING SI;
GETFORMAT(J,K);
SETFORMAT(0,0);
SI←CVIS(X,I);
IF ¬LENGTH(SI) THEN SI ← CVOS(CVN(X));
SETFORMAT(J,K);
RETURN(SI);
END;
INTERNAL STRING PROCEDURE GENSYM (ITEMVAR X);
BEGIN STRING S;
INTEGER ITEMVAR Y;
LABEL L1;
S←PRINTNAME(X);
FOREACH Y | NEXTSYM ⊗ X ≡ Y DO GO TO L1;
Y←NEW(0);
MAKE NEXTSYM ⊗ X ≡ Y;
L1: DATUM(Y)←DATUM(Y)+1;
SETFORMAT(0,0);
S←S&CVS(DATUM(Y));
SETFORMAT (10,6);
RETURN (S);
END;
⊃ *** SOME USEFUL PROCEDURES ***;
INTERNAL BOOLEAN PROCEDURE VERT(ITEMVAR E);
COMMENT IS EDGE E APPROX VERTICAL IN THE PROJECTION?;
BEGIN
SAFE REAL ARRAY ITEMVAR P1,P2;
SET ES; REAL VERLEN,VERTOL;
ES←(ENDPT⊗E);
P1←LOP(ES);
P2←COP(ES);
VERLEN←ABS(DATUM(P1)[6]-DATUM(P2)[6]);
VERTOL←VERLEN/(IF C=5 THEN 5.0 ELSE 4.0);
RETURN(ABS(DATUM(P1)[5]-DATUM(P2)[5])<VERTOL);
END;
INTERNAL REAL PROCEDURE LENTH(ITEMVAR L);
COMMENT RETURNS THE ACTUAL LENGTH OF EDGE L;
BEGIN
SET S;
SAFE REAL ARRAY ITEMVAR U,V;
REAL LENTHG;
S←(ENDPT⊗L);
U←LOP(S);
V←COP(S);
LENTHG←(DATUM(U)[1]-DATUM(V)[1])↑2+
(DATUM(U)[2]-DATUM(V)[2])↑2+(DATUM(U)[3]-DATUM(V)[3])↑2;
LENTHG←SQRT(LENTHG);
RETURN (LENTHG);
END;
INTERNAL REAL PROCEDURE GLENTH(ITEMVAR L);
COMMENT RETURNS THE ACTUAL LENGTH OF EDGE L;
BEGIN
SET S;
SAFE REAL ARRAY ITEMVAR U,V;
S←(GLOBAL ENDPT⊗L);
U←LOP(S);
V←COP(S);
RETURN(SQRT((GLOBAL DATUM(U)[1]-GLOBAL DATUM(V)[1])↑2+
(GLOBAL DATUM(U)[2]-GLOBAL DATUM(V)[2])↑2
+(GLOBAL DATUM(U)[3]-GLOBAL DATUM(V)[3])↑2));
END;
INTERNAL ITEMVAR PROCEDURE NEXTV(SAFE REAL ARRAY ITEMVAR V1,V2);
COMMENT RETURNS NEXT VERTEX IN RING (GOING FROM V1 TO V2);
BEGIN
SET S;
SAFE REAL ARRAY ITEMVAR X,Y;
IF DEB_SIMP
THEN BEGIN TYPE "NEXTV "& PRINTNAME(V1)&" "&PRINTNAME(V2) EOM; WAIT END;
FOREACH LASTL | ENDPT⊗LASTL≡V2 DO
BEGIN
S←(ENDPT⊗LASTL);
IF S∩{V1⎇=PHI THEN
BEGIN
X←LOP(S);
Y←COP(S);
IF X=V2 THEN RETURN (Y) ELSE RETURN (X);
END;
END;
TYPE "NEXTV SCREWUP " EOM;
END;
INTERNAL PROCEDURE CROSS_PROD(SAFE REAL ARRAY A,B,CP);
COMMENT RETRUNS AXB IN CP;
BEGIN
CP[1]←A[2]*B[3]-A[3]*B[2];
CP[2]←A[3]*B[1]-A[1]*B[3];
CP[3]←A[1]*B[2]-A[2]*B[1];
RETURN;
END;
⊃ *** MORE USEFUL ROUTINES ***;
INTERNAL ITEMVAR PROCEDURE HIGHEST(SET S);
COMMENT S IS A SET OF IMAGE VERTICES- RETURNS THE "HIGHEST";
BEGIN
SAFE REAL ARRAY ITEMVAR X,Y;
Y←COP(S);
FOREACH X|XεS DO IF DATUM(X)[6]<DATUM(Y)[6] THEN Y←X;
RETURN(Y);
END;
INTERNAL ITEMVAR PROCEDURE LOWEST(SET S);
COMMENT S IS A SET OF IMAGE VERTICES - RETURNS THE "LOWEST";
BEGIN
SAFE REAL ARRAY ITEMVAR X,Y;
Y←COP(S);
FOREACH X| XεS DO IF DATUM(X)[6]>DATUM(Y)[6] THEN Y←X;
RETURN(Y);
END;
COMMENT T IS TOP AND B IS BOTTOM IMAGE VERTEX ASSUMED TO LIE
ON A LINE NORMAL TO THE TABLE PLANE.
RETURNS WITH THE TRUE 3-D COORDS STUFFED INTO T;
INTERNAL PROCEDURE VERT_LINE_PT(SAFE REAL ARRAY ITEMVAR T,B);
BEGIN OWN SAFE REAL ARRAY TOP,INT,P,BASE[1:3];
INTEGER I;
REAL MISDIS;
∂(T)[3]←(-LENS[3]*(∂(B)[1]-LENS[1])/(∂(T)[1]-LENS[1])) + LENS[3];
∂(T)[1]←∂(B)[1];
∂(T)[2]←∂(B)[2];
COMMENT FOR I←1 S1U 2 DO
BEGIN
TOP[I]←DATUM(T)[I];
COMMENT P[I]←BASE[I]←DATUM(B)[I];
COMMENT END;
COMMENT TOP[3]←BASE[3]←0.0;
COMMENT P[3]←1.0;
COMMENT BESTIN(TOP,LENS,BASE,P,INT,MISDIS);
COMMENT FOR I← 1 S1U 3 DO DATUM(T)[I]←INT[I];
if deb_simp
then begin
type "CALL TO VERT_LINE_PT. "&'12&'15&
" TOP IS "&PRINTNAME(T)&", BOTTOM IS "&PRINTNAME(B) eom;
wait;
end;
END;
INTERNAL PROCEDURE VERT_PLANE_PT(SAFE REAL ARRAY ITEMVAR T,B1,B2);
COMMENT T,B1,B2 ARE IMAGE VERTICES.
T LIES OFF THE TABLE IN A PLANE NORMAL TO THE
THE TABLE WHICH PASSES THRU B1 AND B2.
RETURNS WITH 3-D COORDS STUFFED IN T;
BEGIN
REAL M,B,DX,T1,XT,YT;
DX←DATUM(B2)[1]-DATUM(B1)[1];
M←(DATUM(B2)[2]-DATUM(B1)[2])/DX;
B←(DATUM(B2)[1]*DATUM(B1)[2]-DATUM(B1)[1]*DATUM(B2)[2])/DX;
XT←DATUM(T)[1];
YT←DATUM(T)[2];
T1←(M*XT-YT+B)/(LENS[2]-YT-M*(LENS[1]-XT));
DATUM(T)[1]←T1*LENS[1]+(1.0-T1)*XT;
DATUM(T)[2]←T1*LENS[2]+(1.0-T1)*YT;
DATUM(T)[3]←T1*LENS[3];
if deb_simp
then begin
type "CALL TO VERT_PLANE_PT. "&'12&'15&
" PLANE EDGE:"&PRINTNAME(B1)&","&PRINTNAME(B2)&
" VERTEX:"&PRINTNAME(T) EOM;
wait;
end;
END;
INTERNAL PROCEDURE HORIZ_PLANE_PT(SAFE REAL ARRAY ITEMVAR U,K);
COMMENT U IS AN UNKNOWN IMAGE POINT LYING IN THE SAME PLANE PARALLEL TO
THE TABLE AS K ,A POINT WHOSE 3-D COORDS ARE KNOWN.
RETURNS WITH 3-D COORDS OF U PROPERLY STUFFED IN.;
BEGIN
REAL H,HZC;
H←DATUM(K)[3];
HZC←H/LENS[3];
DATUM(U)[1]←HZC*LENS[1]+DATUM(U)[1]*(1.0-HZC);
DATUM(U)[2]←HZC*LENS[2]+DATUM(U)[2]*(1.0-HZC);
DATUM(U)[3]←H;
if deb_simp
then begin
type "CALL TO HORIZ_PLANE_PT. "&'12&'15&
" UNKNOWN VERTEX:"&PRINTNAME(U)&",KNOWN VERTEX:"&PRINTNAME(K) EOM;
wait;
end;
END;
INTERNAL REAL PROCEDURE DOT_PROD(SAFE REAL ARRAY V1,V2);
COMMENT VALUE IS THE DOT PRODUCT OV VECTORS V1 AND V2.;
BEGIN REAL DP;
INTEGER I;
DP←0.0;
FOR I←1 STEP 1 UNTIL 3 DO DP←DP+V1[I]*V2[I];
RETURN (DP);
END;
INTERNAL REAL PROCEDURE ANGLE(SAFE REAL ARRAY ITEMVAR P1,P2,P3);
COMMENT RETURNS THE ANGLE IN DEGREES OF THE ANGLE FORMED BY P1,P2,P3;
BEGIN
SAFE OWN REAL ARRAY V1,V2[1:3];
INTEGER I;
REAL MSV1,MSV2,X,DOT;
DOT←MSV1←MSV2←0.0;
FOR I←1 S1U 3 DO
BEGIN
V1[I]←DATUM(P1)[I]-DATUM(P2)[I];
V2[I]←DATUM(P3)[I]-DATUM(P2)[I];
DOT←DOT+V1[I]*V2[I];
MSV1←MSV1+V1[I]↑2;
MSV2←MSV2+V2[I]↑2;
END;
X←DOT/SQRT(MSV1*MSV2);
IF ABS(X)>1.0
THEN BEGIN
TYPE "SIMPLE - ANGLE COMPLAINING THAT "&CVG(X)&" IS GREATER THAN 1.0" EOM;
X←IF X<0.0 THEN -1.0 ELSE 1.0;
END;
X←57.3*ACOS(X);
RETURN(X);
END;
INTERNAL BOOLEAN PROCEDURE PARALLEL(ITEMVAR E1,E2);
BEGIN
REAL PROCEDURE SLOPE(ITEMVAR L);
BEGIN
SAFE REAL ARRAY ITEMVAR P1,P2;
SET S;
REAL M;
S←(ENDPT⊗L);
P1←LOP(S);
P2←COP(S);
M←(DATUM(P2)[6]-DATUM(P1)[6])/(DATUM(P2)[5]-DATUM(P1)[5]);
IF DEB_SIMP THEN
BEGIN
TYPE PRINTNAME(P1)&" "&PRINTNAME(P2) EOM; WAIT;
TYPE "SLOPE= "&CVG(M) EOM;
END;
RETURN (M);
END;
REAL T1,T2;
T1←57.3*ATAN(SLOPE(E1));
T2←57.3*ATAN(SLOPE(E2));
IF DEB_SIMP THEN
BEGIN
TYPE "CALL TO PARALLEL: T1-T2= "&CVG(T1-T2) EOM;
WAIT;
END;
IF ABS(T1-T2)<10.0 THEN RETURN (TRUE) ELSE RETURN (FALSE);
END;
INTERNAL PROCEDURE VERT0;
BEGIN LABEL L1,L2;
ITEMVAR E1,E2,E3,E4;
X←HIGHEST(SVS);
S1←(ENDPT`X);
E1←LOP(S1);
E2←COP(S1);
ASSIGN E3|E3εSES AND (E3≠E1) AND (E3≠E2) AND ADJ(E3,E1) HOLDS;
ASSIGN E4| E4εSES AND (E4≠E2) AND (E4≠E1) AND ADJ(E4,E2) HOLDS;
IF VERT0F>0 THEN GOTO L1 ELSE IF VERT0F<0 THEN GOTO L2;
IF ABS(LENTH(E3)-LENTH(E4))<0.4 THEN
L1:BEGIN
IF DEB_SIMP THEN
BEGIN
TYPE "CALL TO VERT0: E3 AND E4 PARALLEL." EOM;
WAIT;
END;
V1←X;
ASSIGN V2| ENDPT⊗E1≡V2 AND ENDPT⊗E3≡V2 HOLDS;
V3←NEXTV(V1,V2);
V4←NEXTV(V2,V3);
ASSIGN B| ENDPT⊗E2≡B AND ENDPT⊗E4≡B HOLDS;
VERT_PLANE_PT(V1,V2,B);
VERT0F← -1; RETURN;
END ELSE L2:BEGIN
IF DEB_SIMP THEN
BEGIN
TYPE "CALL TO VERT0: E3 AND E4 NOT PARALLEL." EOM;
WAIT;
END;
S1←SVS;
REMOVE X FROM S1;
V1←HIGHEST(S1);
V2←NEXTV(X,V1);
V3←NEXTV(V1,V2);
V4←NEXTV(V2,V3);
VERT_PLANE_PT(V1,V2,V3);
VERT0F←1;
END;
END;
INTERNAL PROCEDURE VERT1;
BEGIN
FOREACH Y|YεVERTEDG DO
BEGIN
S1←(ENDPT⊗Y);
V1←LOP(S1);
V2←COP(S1);
IF DATUM(V1)[6]>DATUM(V2)[6] THEN
BEGIN X←V2; V2←V1; V1←X; END;
V3←NEXTV(V1,V2);
V4←NEXTV(V2,V3);
VERT_LINE_PT(V1,V2);
COMMENT horiz_plane_pt(v3,v2);
COMMENT horiz_plane_pt(v4,v2);
IF SPECIAL_VERT THEN BEGIN
V4←V3; V3←V2; V2←V1; V1←NEXTV(V3,V2);
HORIZ_PLANE_PT (V1,V2);
IF DEB_SIMP THEN BEGIN
TYPE "SPECIAL TWO-VERTICAL CASE" EOM;
WAIT; END;
END;
RETURN;
END;
END;
INTERNAL PROCEDURE VERT2;
BEGIN
X←LOWEST(SVS);
S1←(ENDPT`X)∩ VERTEDG;
BVERT←FALSE;
IF S1=PHI THEN BEGIN VERT1; RETURN END;
V1←HIGHEST(SVS);
S1←SVS-{V1⎇;
V2←HIGHEST(S1);
V3←NEXTV(V1,V2);
V4←NEXTV(V2,V3);
VERT_LINE_PT(V2,V3);
HORIZ_PLANE_PT(V1,V2);
END;
END "AUXILIARY SIMPLE PROCEDURES";